home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000
/
Ham Radio 2000.iso
/
ham2000
/
misc
/
dspice0s
/
dcdcmp.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-21
|
24KB
|
793 lines
/* dcdcmp.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
lvntmp;
} tabinf_;
#define tabinf_1 tabinf_
struct {
doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas,
rstats[50];
integer iwidth, lwidth, nopage;
} miscel_;
#define miscel_1 miscel_
struct {
integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt,
nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
} cirdat_;
#define cirdat_1 cirdat_
struct {
doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu,
sfactr;
integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno,
itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
} status_;
#define status_1 status_
struct {
integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod,
lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
} flags_;
#define flags_1 flags_
struct {
doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin,
reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
pivrel;
} knstnt_;
#define knstnt_1 knstnt_
struct {
integer idebug[20];
} debug_;
#define debug_1 debug_
struct {
doublereal value[200000];
} blank_;
#define blank_1 blank_
/* Table of constant values */
static integer c__1 = 1;
/*< subroutine dcdcmp >*/
/* Subroutine */ int dcdcmp_()
{
/* Format strings */
static char fmt_51[] = "(\0020*error*: maximum entry in this column at \
step \002,i4,\002 (\002,1pd12.6,\002) is less than pivtol\002)";
static char fmt_92[] = "(\0020*abort*: pivot not in dcdcmp\002)";
static char fmt_221[] = "(\002 pivot change on fly: n= \002,i5,\002 nxti\
= \002,i5,\002 nxtj= \002,i5,\002 iterno= \002,i5,\002 time= \002,1pd12.5)";
/* System generated locals */
integer i_1;
doublereal d_1;
/* Builtin functions */
integer s_wsfe(), do_fio(), e_wsfe();
/* Local variables */
static integer load, locc, loci, noff, locr, iops;
static doublereal vmax;
static integer nxti, nxtj, i, j, n, noffc, locij, ifill, locnn, noffr,
minop, i1;
static doublereal t1;
static integer j1, ispot;
extern integer indxx_();
static integer n1, n2;
static doublereal t2;
static integer isize1, isize2, lc, nstop1, no, lr;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
extern /* Subroutine */ int second_(), dmpmat_();
static doublereal epsrel;
extern /* Subroutine */ int swapij_(), sizmem_(), reserv_(), extmem_();
static integer loc;
extern /* Subroutine */ int matloc_();
static doublereal perspa;
static integer nop;
/* Fortran I/O blocks */
static cilist io__12 = { 0, 0, 0, fmt_51, 0 };
static cilist io__20 = { 0, 0, 0, fmt_92, 0 };
static cilist io__40 = { 0, 0, 0, fmt_221, 0 };
/*< implicit double precision (a-h,o-z) >*/
/* this routine swaps rows and columns in the coefficient matrix
accor-*/
/*ding to the numerical pivoting and minimum fillin terms.it then
performs*/
/* an in-place lu factorization of the coefficient matrix. */
/* spice version 2g.6 sccsid=tabinf 3/15/83 */
/*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
/*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
/*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
/*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
/*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
/*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
/*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
/*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
/* spice version 2g.6 sccsid=miscel 3/15/83 */
/*< common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
/*< 1 defas,rstats(50),iwidth,lwidth,nopage >*/
/* spice version 2g.6 sccsid=cirdat 3/15/83 */
/*< common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
/*< 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
/* spice version 2g.6 sccsid=status 3/15/83 */
/*< common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
/*< 1 xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
/*< 2 iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
/* spice version 2g.6 sccsid=flags 3/15/83 */
/*< common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
/*< 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
/* spice version 2g.6 sccsid=knstnt 3/15/83 */
/*< common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
/*< 1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
/*< 2 pivtol,pivrel >*/
/* spice version 2g.6 sccsid=debug 3/15/83 */
/*< common/debug/ idebug(20) >*/
/* spice version 2g.6 sccsid=blank 3/15/83 */
/*< common /blank/ value(200000) >*/
/*< integer nodplc(64) >*/
/*< complex cvalue(32) >*/
/*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
/*< call second(t1) >*/
second_(&t1);
/*< if (ipiv.le.0) go to 12 >*/
if (status_1.ipiv <= 0) {
goto L12;
}
/*< if (idebug(11).le.0) go to 3 >*/
if (debug_1.idebug[10] <= 0) {
goto L3;
}
/*< call dmpmat(6hdcdcmp) >*/
dmpmat_("dcdcmp", 6L);
/*< idebug(11)=idebug(11)-1 >*/
--debug_1.idebug[10];
/*< 3 do 10 i=2,nstop >*/
L3:
i_1 = cirdat_1.nstop;
for (i = 2; i <= i_1; ++i) {
/*< no=0 >*/
no = 0;
/*< loc=nodplc(jcpt+i) >*/
loc = nodplc[tabinf_1.jcpt + i - 1];
/*< 5 if (loc.eq.0) go to 7 >*/
L5:
if (loc == 0) {
goto L7;
}
/*< no=no+1 >*/
++no;
/*< loc=nodplc(jcpt+loc) >*/
loc = nodplc[tabinf_1.jcpt + loc - 1];
/*< go to 5 >*/
goto L5;
/*< 7 nodplc(numoff+i)=no >*/
L7:
nodplc[tabinf_1.numoff + i - 1] = no;
/*< no=0 >*/
no = 0;
/*< loc=nodplc(irpt+i) >*/
loc = nodplc[tabinf_1.irpt + i - 1];
/*< 8 if (loc.eq.0) go to 9 >*/
L8:
if (loc == 0) {
goto L9;
}
/*< no=no+1 >*/
++no;
/*< loc=nodplc(irpt+loc) >*/
loc = nodplc[tabinf_1.irpt + loc - 1];
/*< go to 8 >*/
goto L8;
/*< 9 nodplc(nmoffc+i)=no >*/
L9:
nodplc[tabinf_1.nmoffc + i - 1] = no;
/*< 10 continue >*/
/* L10: */
}
/*< 12 n=1 >*/
L12:
n = 1;
/* find next pivot */
/*< 15 n=n+1 >*/
L15:
++n;
/*< if (ipiv.gt.0) go to 20 >*/
if (status_1.ipiv > 0) {
goto L20;
}
/*< if (idebug(13).le.0) go to 17 >*/
if (debug_1.idebug[12] <= 0) {
goto L17;
}
/*< call dmpmat(6hdcdcm2) >*/
dmpmat_("dcdcm2", 6L);
/*< idebug(13)=idebug(13)-1 >*/
--debug_1.idebug[12];
/*< 17 if (idebug(14).le.0) go to 18 >*/
L17:
if (debug_1.idebug[13] <= 0) {
goto L18;
}
/*< if (mode.ne.2) go to 18 >*/
if (status_1.mode != 2) {
goto L18;
}
/*< call dmpmat(6hdcdcm3) >*/
dmpmat_("dcdcm3", 6L);
/*< idebug(14)=idebug(14)-1 >*/
--debug_1.idebug[13];
/*< 18 if (idebug(15).le.0.or.icalc.le.10) go to 19 >*/
L18:
if (debug_1.idebug[14] <= 0 || status_1.icalc <= 10) {
goto L19;
}
/*< call dmpmat(6hdcdcm4) >*/
dmpmat_("dcdcm4", 6L);
/*< idebug(15)=idebug(15)-1 >*/
--debug_1.idebug[14];
/*< 19 nxti=n >*/
L19:
nxti = n;
/*< nxtj=n >*/
nxtj = n;
/*< go to 120 >*/
goto L120;
/* search the coresponding column for max entry */
/*< 20 vmax=0.0d0 >*/
L20:
vmax = 0.;
/*< loci=n >*/
loci = n;
/*< 25 loci=nodplc(irpt+loci) >*/
L25:
loci = nodplc[tabinf_1.irpt + loci - 1];
/*< if (loci.eq.0) go to 50 >*/
if (loci == 0) {
goto L50;
}
/*< i=nodplc(irowno+loci) >*/
i = nodplc[tabinf_1.irowno + loci - 1];
/*< if (i.lt.n) go to 25 >*/
if (i < n) {
goto L25;
}
/*< 30 if (dabs(value(lvn+loci)).le.vmax) go to 25 >*/
/* L30: */
if ((d_1 = blank_1.value[tabinf_1.lvn + loci - 1], abs(d_1)) <= vmax) {
goto L25;
}
/*< vmax=dabs(value(lvn+loci)) >*/
vmax = (d_1 = blank_1.value[tabinf_1.lvn + loci - 1], abs(d_1));
/*< go to 25 >*/
goto L25;
/*< 50 if (vmax.gt.pivtol) go to 60 >*/
L50:
if (vmax > knstnt_1.pivtol) {
goto L60;
}
/*< write(iofile,51) n,vmax >*/
io__12.ciunit = status_1.iofile;
s_wsfe(&io__12);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&vmax, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 51 format('0*error*: maximum entry in this column at step ',i4,' (', >*/
/*< 1 1pd12.6,') is less than pivtol') >*/
/*< igoof=1 >*/
flags_1.igoof = 1;
/*< return >*/
return 0;
/*< 60 epsrel=dmax1(pivrel*vmax,pivtol) >*/
L60:
/* Computing MAX */
d_1 = knstnt_1.pivrel * vmax;
epsrel = max(knstnt_1.pivtol,d_1);
/*< if (n.ge.nstop) go to 200 >*/
if (n >= cirdat_1.nstop) {
goto L200;
}
/*< if (ipiv.le.0) go to 120 >*/
if (status_1.ipiv <= 0) {
goto L120;
}
/* pivoting on the diagonal */
/*< minop=100000 >*/
minop = 100000;
/*< nxti=0 >*/
nxti = 0;
/*< do 70 i=n,nstop >*/
i_1 = cirdat_1.nstop;
for (i = n; i <= i_1; ++i) {
/*< i1=nodplc(irswpf+i) >*/
i1 = nodplc[tabinf_1.irswpf + i - 1];
/*< j1=nodplc(icswpf+i) >*/
j1 = nodplc[tabinf_1.icswpf + i - 1];
/*< ispot=indxx(i1,j1) >*/
ispot = indxx_(&i1, &j1);
/*< if (ispot.eq.1) go to 70 >*/
if (ispot == 1) {
goto L70;
}
/*< if (dabs(value(lvn+ispot)).lt.epsrel) go to 70 >*/
if ((d_1 = blank_1.value[tabinf_1.lvn + ispot - 1], abs(d_1)) <
epsrel) {
goto L70;
}
/*< nop=(nodplc(numoff+i)-1)*(nodplc(nmoffc+i)-1) >*/
nop = (nodplc[tabinf_1.numoff + i - 1] - 1) * (nodplc[tabinf_1.nmoffc
+ i - 1] - 1);
/*< if (nop.ge.minop) go to 70 >*/
if (nop >= minop) {
goto L70;
}
/*< minop=nop >*/
minop = nop;
/*< nxti=i >*/
nxti = i;
/*< nxtj=i >*/
nxtj = i;
/*< if (minop.le.0) go to 95 >*/
if (minop <= 0) {
goto L95;
}
/*< 70 continue >*/
L70:
;}
/*< if (nxti.le.0) go to 75 >*/
if (nxti <= 0) {
goto L75;
}
/*< if (nxti-n) 120,120,100 >*/
if (nxti - n <= 0) {
goto L120;
} else {
goto L100;
}
/* pivoting on the entire matrix */
/*< 75 do 90 i=n,nstop >*/
L75:
i_1 = cirdat_1.nstop;
for (i = n; i <= i_1; ++i) {
/*< loc=i >*/
loc = i;
/*< 80 loc=nodplc(jcpt+loc) >*/
L80:
loc = nodplc[tabinf_1.jcpt + loc - 1];
/*< if (loc.eq.0) go to 90 >*/
if (loc == 0) {
goto L90;
}
/*< j=nodplc(jcolno+loc) >*/
j = nodplc[tabinf_1.jcolno + loc - 1];
/*< if (j.lt.n) go to 80 >*/
if (j < n) {
goto L80;
}
/*< if (dabs(value(lvn+loc)).lt.epsrel) go to 80 >*/
if ((d_1 = blank_1.value[tabinf_1.lvn + loc - 1], abs(d_1)) < epsrel)
{
goto L80;
}
/*< nop=(nodplc(numoff+i)-1)*(nodplc(nmoffc+j)-1) >*/
nop = (nodplc[tabinf_1.numoff + i - 1] - 1) * (nodplc[tabinf_1.nmoffc
+ j - 1] - 1);
/*< if (nop.ge.minop) go to 80 >*/
if (nop >= minop) {
goto L80;
}
/*< minop=nop >*/
minop = nop;
/*< nxti=i >*/
nxti = i;
/*< nxtj=j >*/
nxtj = j;
/*< if (minop.le.0) go to 95 >*/
if (minop <= 0) {
goto L95;
}
/*< 90 continue >*/
L90:
;}
/*< if (nxti.gt.0) go to 95 >*/
if (nxti > 0) {
goto L95;
}
/*< write (iofile,92) >*/
io__20.ciunit = status_1.iofile;
s_wsfe(&io__20);
e_wsfe();
/*< 92 format('0*abort*: pivot not in dcdcmp') >*/
/*< igoof=1 >*/
flags_1.igoof = 1;
/*< go to 200 >*/
goto L200;
/*< 95 if (nxti.eq.n.and.nxtj.eq.n) go to 120 >*/
L95:
if (nxti == n && nxtj == n) {
goto L120;
}
/*< if (nxti.eq.n) go to 105 >*/
if (nxti == n) {
goto L105;
}
/* a pivot has been found */
/*< 100 load=nodplc(irswpf+nxti) >*/
L100:
load = nodplc[tabinf_1.irswpf + nxti - 1];
/*< lr=nodplc(irswpf+n) >*/
lr = nodplc[tabinf_1.irswpf + n - 1];
/*< nodplc(irswpf+nxti)=lr >*/
nodplc[tabinf_1.irswpf + nxti - 1] = lr;
/*< nodplc(irswpr+lr)=nxti >*/
nodplc[tabinf_1.irswpr + lr - 1] = nxti;
/*< nodplc(irswpf+n)=load >*/
nodplc[tabinf_1.irswpf + n - 1] = load;
/*< nodplc(irswpr+load)=n >*/
nodplc[tabinf_1.irswpr + load - 1] = n;
/*< noff=nodplc(numoff+nxti) >*/
noff = nodplc[tabinf_1.numoff + nxti - 1];
/*< nodplc(numoff+nxti)=nodplc(numoff+n) >*/
nodplc[tabinf_1.numoff + nxti - 1] = nodplc[tabinf_1.numoff + n - 1];
/*< nodplc(numoff+n)=noff >*/
nodplc[tabinf_1.numoff + n - 1] = noff;
/*< if (nxtj.eq.n) go to 110 >*/
if (nxtj == n) {
goto L110;
}
/*< 105 load=nodplc(icswpf+nxtj) >*/
L105:
load = nodplc[tabinf_1.icswpf + nxtj - 1];
/*< lc=nodplc(icswpf+n) >*/
lc = nodplc[tabinf_1.icswpf + n - 1];
/*< nodplc(icswpf+nxtj)=lc >*/
nodplc[tabinf_1.icswpf + nxtj - 1] = lc;
/*< nodplc(icswpr+lc)=nxtj >*/
nodplc[tabinf_1.icswpr + lc - 1] = nxtj;
/*< nodplc(icswpf+n)=load >*/
nodplc[tabinf_1.icswpf + n - 1] = load;
/*< nodplc(icswpr+load)=n >*/
nodplc[tabinf_1.icswpr + load - 1] = n;
/*< noff=nodplc(nmoffc+nxtj) >*/
noff = nodplc[tabinf_1.nmoffc + nxtj - 1];
/*< nodplc(nmoffc+nxtj)=nodplc(nmoffc+n) >*/
nodplc[tabinf_1.nmoffc + nxtj - 1] = nodplc[tabinf_1.nmoffc + n - 1];
/*< nodplc(nmoffc+n)=noff >*/
nodplc[tabinf_1.nmoffc + n - 1] = noff;
/*< 110 call swapij(nxti,n,nxtj,n) >*/
L110:
swapij_(&nxti, &n, &nxtj, &n);
/*< nxti=n >*/
nxti = n;
/*< nxtj=n >*/
nxtj = n;
/* calculate contribution from nxti, nxtj and find fill-ins */
/*< 120 if (n.ge.nstop) go to 200 >*/
L120:
if (n >= cirdat_1.nstop) {
goto L200;
}
/*< n1=nodplc(irswpf+nxti) >*/
n1 = nodplc[tabinf_1.irswpf + nxti - 1];
/*< n2=nodplc(icswpf+nxtj) >*/
n2 = nodplc[tabinf_1.icswpf + nxtj - 1];
/*< locnn=indxx(n1,n2) >*/
locnn = indxx_(&n1, &n2);
/*< if (ipiv.le.0 .and. dabs(value(lvn+locnn)).lt.pivtol) go to 220 >*/
if (status_1.ipiv <= 0 && (d_1 = blank_1.value[tabinf_1.lvn + locnn - 1],
abs(d_1)) < knstnt_1.pivtol) {
goto L220;
}
/* down col j */
/*< locr=nodplc(irpt+locnn) >*/
locr = nodplc[tabinf_1.irpt + locnn - 1];
/*< 125 if (locr.eq.0) go to 180 >*/
L125:
if (locr == 0) {
goto L180;
}
/*< i=nodplc(irowno+locr) >*/
i = nodplc[tabinf_1.irowno + locr - 1];
/*< value(lvn+locr)=value(lvn+locr)/value(lvn+locnn) >*/
blank_1.value[tabinf_1.lvn + locr - 1] /= blank_1.value[tabinf_1.lvn +
locnn - 1];
/*< locc=nodplc(jcpt+locnn) >*/
locc = nodplc[tabinf_1.jcpt + locnn - 1];
/* for each column element look up row nxti */
/*< 130 if (locc.eq.0) go to 170 >*/
L130:
if (locc == 0) {
goto L170;
}
/*< j=nodplc(jcolno+locc) >*/
j = nodplc[tabinf_1.jcolno + locc - 1];
/* check for fill-in (i,j) */
/*< if (ipiv.le.0) go to 135 >*/
if (status_1.ipiv <= 0) {
goto L135;
}
/*< call sizmem(jcpt,isize1) >*/
sizmem_(&tabinf_1.jcpt, &isize1);
/*< call reserv(i,j) >*/
reserv_(&i, &j);
/*< call sizmem(jcpt,isize2) >*/
sizmem_(&tabinf_1.jcpt, &isize2);
/*< if (isize1.eq.isize2) go to 135 >*/
if (isize1 == isize2) {
goto L135;
}
/*< call extmem(lvn,1) >*/
extmem_(&tabinf_1.lvn, &c__1);
/*< nttbr=nttbr+1 >*/
++tabinf_1.nttbr;
/*< value(lvn+nstop+nttbr)=0.0d0 >*/
blank_1.value[tabinf_1.lvn + cirdat_1.nstop + tabinf_1.nttbr - 1] = 0.;
/* locate element (i,j) */
/*< 135 if (j.lt.i) go to 145 >*/
L135:
if (j < i) {
goto L145;
}
/*< locij=locc >*/
locij = locc;
/*< 140 locij=nodplc(irpt+locij) >*/
L140:
locij = nodplc[tabinf_1.irpt + locij - 1];
/*< if (nodplc(irowno+locij).eq.i) go to 155 >*/
if (nodplc[tabinf_1.irowno + locij - 1] == i) {
goto L155;
}
/*< go to 140 >*/
goto L140;
/*< 145 locij=locr >*/
L145:
locij = locr;
/*< 150 locij=nodplc(jcpt+locij) >*/
L150:
locij = nodplc[tabinf_1.jcpt + locij - 1];
/*< if (nodplc(jcolno+locij).eq.j) go to 155 >*/
if (nodplc[tabinf_1.jcolno + locij - 1] == j) {
goto L155;
}
/*< go to 150 >*/
goto L150;
/*< 155 value(lvn+locij)=value(lvn+locij)- >*/
/*< 1 value(lvn+locc)*value(lvn+locr) >*/
L155:
blank_1.value[tabinf_1.lvn + locij - 1] -= blank_1.value[tabinf_1.lvn +
locc - 1] * blank_1.value[tabinf_1.lvn + locr - 1];
/*< 160 locc=nodplc(jcpt+locc) >*/
/* L160: */
locc = nodplc[tabinf_1.jcpt + locc - 1];
/*< go to 130 >*/
goto L130;
/*< 170 locr=nodplc(irpt+locr) >*/
L170:
locr = nodplc[tabinf_1.irpt + locr - 1];
/*< if (ipiv.le.0) go to 125 >*/
if (status_1.ipiv <= 0) {
goto L125;
}
/*< nodplc(numoff+i)=nodplc(numoff+i)-1 >*/
--nodplc[tabinf_1.numoff + i - 1];
/*< go to 125 >*/
goto L125;
/* reduce nmoffc for each element in col nxti */
/*< 180 if (ipiv.le.0) go to 15 >*/
L180:
if (status_1.ipiv <= 0) {
goto L15;
}
/*< locc=nodplc(jcpt+locnn) >*/
locc = nodplc[tabinf_1.jcpt + locnn - 1];
/*< 185 if (locc.eq.0) go to 15 >*/
L185:
if (locc == 0) {
goto L15;
}
/*< j=nodplc(jcolno+locc) >*/
j = nodplc[tabinf_1.jcolno + locc - 1];
/*< nodplc(nmoffc+j)=nodplc(nmoffc+j)-1 >*/
--nodplc[tabinf_1.nmoffc + j - 1];
/*< locc=nodplc(jcpt+locc) >*/
locc = nodplc[tabinf_1.jcpt + locc - 1];
/*< go to 185 >*/
goto L185;
/* done */
/*< 200 if (ipiv.eq.0) go to 210 >*/
L200:
if (status_1.ipiv == 0) {
goto L210;
}
/*< if (idebug(17).le.0) go to 202 >*/
if (debug_1.idebug[16] <= 0) {
goto L202;
}
/*< call dmpmat(6hdcdcm5) >*/
dmpmat_("dcdcm5", 6L);
/*< idebug(17)=idebug(17)-1 >*/
--debug_1.idebug[16];
/*< 202 call matloc >*/
L202:
matloc_();
/*< rstats(49)=rstats(49)+1.0d0 >*/
miscel_1.rstats[48] += 1.;
/*< ipiv=0 >*/
status_1.ipiv = 0;
/*< if (lvlcod.eq.2) lvlcod=3 >*/
if (flags_1.lvlcod == 2) {
flags_1.lvlcod = 3;
}
/*< ifill=nttbr-nttar >*/
ifill = tabinf_1.nttbr - tabinf_1.nttar;
/*< perspa=100.0d0*(1.0d0-dble(nttbr)/dble(nstop*nstop)) >*/
perspa = (1. - (doublereal) tabinf_1.nttbr / (doublereal) (cirdat_1.nstop
* cirdat_1.nstop)) * 100.;
/* calculation of operation count (operation := `*' or `/'): */
/* noffr := off-diagonal elements in row, not including diagonal, */
/* counting only those elements in the remainder matrix */
/* noffc := off-diagonal elements in column, not including diagonal,
*/
/* counting only those elements in the remainder matrix */
/* then we have */
/* lu decomposition requires sigma(2,nstop-1) {noffc + noffc*
noffr}*/
/* forward substitution sigma(2,nstop-1) {noffc + 1} +
1*/
/* backward substitution sigma(2,nstop-1) {noffr} */
/* which sums to */
/* sigma(2,nstop-1) {noffc + noffc*noffr + (noffc+1) + noffr}
+ 1*/
/* or */
/* sigma(2,nstop-1) {noffc*(noffr+2) + noffr + 1} + 1 */
/*< iops=1 >*/
iops = 1;
/*< nstop1=nstop-1 >*/
nstop1 = cirdat_1.nstop - 1;
/*< do 205 i=2,nstop1 >*/
i_1 = nstop1;
for (i = 2; i <= i_1; ++i) {
/*< noffr=nodplc(numoff+i)-1 >*/
noffr = nodplc[tabinf_1.numoff + i - 1] - 1;
/*< noffc=nodplc(nmoffc+i)-1 >*/
noffc = nodplc[tabinf_1.nmoffc + i - 1] - 1;
/*< iops=iops+noffr+noffc*(noffr+2)+1 >*/
iops = iops + noffr + noffc * (noffr + 2) + 1;
/*< 205 continue >*/
/* L205: */
}
/*< rstats(20)=nstop >*/
miscel_1.rstats[19] = (doublereal) cirdat_1.nstop;
/*< rstats(21)=nttar >*/
miscel_1.rstats[20] = (doublereal) tabinf_1.nttar;
/*< rstats(22)=nttbr >*/
miscel_1.rstats[21] = (doublereal) tabinf_1.nttbr;
/*< rstats(23)=ifill >*/
miscel_1.rstats[22] = (doublereal) ifill;
/*< rstats(24)=0.0d0 >*/
miscel_1.rstats[23] = 0.;
/*< rstats(25)=nttbr >*/
miscel_1.rstats[24] = (doublereal) tabinf_1.nttbr;
/*< rstats(26)=iops >*/
miscel_1.rstats[25] = (doublereal) iops;
/*< rstats(27)=perspa >*/
miscel_1.rstats[26] = perspa;
/*< go to 215 >*/
goto L215;
/*< 210 if (idebug(18).le.0) go to 212 >*/
L210:
if (debug_1.idebug[17] <= 0) {
goto L212;
}
/*< call dmpmat(6hdcdcm6) >*/
dmpmat_("dcdcm6", 6L);
/*< idebug(18)=idebug(18)-1 >*/
--debug_1.idebug[17];
/*< 212 if (idebug(19).le.0.or.icalc.le.10) go to 215 >*/
L212:
if (debug_1.idebug[18] <= 0 || status_1.icalc <= 10) {
goto L215;
}
/*< call dmpmat(6hdcdcm7) >*/
dmpmat_("dcdcm7", 6L);
/*< idebug(19)=idebug(19)-1 >*/
--debug_1.idebug[18];
/*< 215 call second(t2) >*/
L215:
second_(&t2);
/*< rstats(50)=rstats(50)+t2-t1 >*/
miscel_1.rstats[49] = miscel_1.rstats[49] + t2 - t1;
/*< return >*/
return 0;
/*< 220 ipiv=1 >*/
L220:
status_1.ipiv = 1;
/*< write(iofile,221) n,nxti,nxtj,iterno,time >*/
io__40.ciunit = status_1.iofile;
s_wsfe(&io__40);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&nxti, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&nxtj, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&status_1.iterno, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&status_1.time, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 221 format(' pivot change on fly: n= ',i5,' nxti= ',i5,' nxtj= ', >*/
/*< 1 i5,' iterno= ',i5,' time= ',1pd12.5) >*/
/*< rstats(49)=rstats(49)+1.0d0 >*/
miscel_1.rstats[48] += 1.;
/*< go to 20 >*/
goto L20;
/*< end >*/
} /* dcdcmp_ */
#undef cvalue
#undef nodplc